home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
graphic
/
tpega.zip
/
GPSHADE.P
< prev
next >
Wrap
Text File
|
1986-02-01
|
2KB
|
63 lines
{ }
{ EGA Graphic Primitive for Turbo Pascal 3.01A, Version 01FEB86. }
{ (C) 1986 by Kent Cedola, 2015 Meadow Lake Ct., Norfolk, VA, 23518 }
{ }
{ Description: Set the current style for line drawing primitives. }
{ Setting the shading will set the shading flag on and setting the }
{ current color will reset it zero. If the shading flag is zero then }
{ the current color will be used, else the line style. }
{ }
procedure GPSHADE(Var Shade);
var
mx,my,x,y,x1,y1,i: Integer;
colors: array [0..65] of byte absolute Shade;
begin
GDSHADE := addr(Shade);
mx := colors[0];
my := colors[1];
x := 0;
y := 0;
x1 := 0;
y1 := 0;
for i := 0 to 63 do
begin
if x1 = 8 then
begin
x1 := 0;
y1 := y1 + 1;
y := y + 1;
end;
if x = mx then
begin
x := 0;
end;
if y = my then
begin
y := 0;
end;
GDSHADE1[y1*8+x1+2] := colors[y*mx+x+2];
x := x + 1;
x1 := x1 + 1;
end;
GDSHADE1[0] := 8;
GDSHADE1[1] := 8;
inline
($C7/$06/GDS_FLG/$FFFF /$BA/$03CE /$B8/$0205 /$EF /$B0/$08 /$EE /$42
/$8E/$06/GDGSEG /$8D/$36/GDSHADE1 /$46 /$46 /$8B/$3E/GDGSADR /$B9/>$40
/$B0/$80 /$EE /$26/$8A/$25 /$8A/$24 /$26/$88/$25 /$D0/$C8 /$83/$D7/$00
/$46 /$E2/$EF /$B0/$FF /$EE /$4A /$B8/>$05 /$EF);
end;